home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / csfilesc / csmisc.bas < prev    next >
Encoding:
BASIC Source File  |  1998-09-24  |  4.5 KB  |  145 lines
  1. Attribute VB_Name = "CSMiscellaneous"
  2. Option Explicit
  3.  
  4. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  5. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  6. Public Const GWL_STYLE = (-16)
  7. Public Const WS_CHILD = &H40000000
  8.  
  9. Public m_JumpLink As Boolean
  10.  
  11. ' Public m_UserControl As Object
  12. Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  13. #If UNICODE Then
  14.     Public Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal uMgs As Long, ByVal wParam As Long, lParam As Any) As Long
  15. #Else
  16.     Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal uMgs As Long, ByVal wParam As Long, lParam As Any) As Long
  17. #End If
  18. Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  19. Public Declare Function ReleaseCapture Lib "user32" () As Long
  20.  
  21. 'Messages to relay to ToolTip
  22. Public Const WM_USER = &H400
  23. Public Const WM_NOTIFY = &H4E
  24. Public Const WM_MOUSEMOVE = &H200
  25. Public Const WM_LBUTTONDOWN = &H201
  26. Public Const WM_LBUTTONUP = &H202
  27. Public Const WM_RBUTTONDOWN = &H204
  28. Public Const WM_RBUTTONUP = &H205
  29. Public Const WM_MBUTTONDOWN = &H207
  30. Public Const WM_MBUTTONUP = &H208
  31.  
  32. 'ToolTip style
  33. Public Const TTF_IDISHWND = &H1
  34.  
  35. 'Tool Tip messages
  36. Public Const TTM_ACTIVATE = (WM_USER + 1)
  37. #If UNICODE Then
  38.     Public Const TTM_ADDTOOLW = (WM_USER + 50)
  39.     Public Const TTM_ADDTOOL = TTM_ADDTOOLW
  40. #Else
  41.     Public Const TTM_ADDTOOLA = (WM_USER + 4)
  42.     Public Const TTM_ADDTOOL = TTM_ADDTOOLA
  43. #End If
  44. Public Const TTM_RELAYEVENT = (WM_USER + 7)
  45.  
  46. Public Const WND_WIDTH = 223
  47. Public Const WND_HEIGHT = 237
  48. Public Const WND2_HEIGHT = 167
  49. Public Const WND2_WIDTH = 288
  50.  
  51. Const WND_W_ABOUT = 223
  52. Const WND_W_GETDATES = 288
  53. Const WND_W_DATEOUT = 321
  54. Const WND_W_INPUT = 311
  55. Const WND_W_SELECT = 214
  56.  
  57. Const WND_H_ABOUT = 93 + 16
  58. Const WND_H_GETDATES = 151 + 16
  59. Const WND_H_DATEOUT = 181 + 16
  60. Const WND_H_INPUT = 120 + 16
  61. Const WND_H_SELECT = 212
  62.  
  63. ' Set some constant values (from WIN32API.TXT).
  64. Public Const conHwndTopmost = -1
  65. Public Const conHwndNoTopmost = -2
  66. Public Const SWP_NOMOVE = &H2
  67. Public Const SWP_NOSIZE = &H1
  68. Public Const conSwpNoActivate = &H10
  69. Public Const conSwpShowWindow = &H40
  70.  
  71. Public Sub Capture(Optional ByVal hwnd As Long = 0)
  72.     
  73.     On Error Resume Next
  74.     If hwnd <> 0 Then
  75.         SetCapture (hwnd)
  76.     Else
  77.         ReleaseCapture
  78.     End If
  79.         
  80. End Sub
  81.  
  82. Public Function ShowTopmost(F As Form, Optional ByVal lft As Long = 0, Optional ByVal tp As Long = 0, Optional ByVal wd As Long = WND_W_SELECT, Optional ByVal ht As Long = WND_H_SELECT) As Boolean
  83.     
  84.     On Error Resume Next
  85.             
  86.     SetWindowPos F.hwnd, conHwndTopmost, F.ScaleX(F.Left, vbTwips, vbPixels), F.ScaleY(F.Top, vbTwips, vbPixels), F.ScaleWidth + 4, F.ScaleHeight + 25, conSwpNoActivate
  87.     F.Show
  88.     If Err <> 0 And F.Visible = False Then
  89.         F.Show 1
  90.     Else
  91.         F.ZOrder
  92.     End If
  93.    
  94. End Function
  95.  
  96.  
  97. Public Function LongToBytes(ByVal lVal As Long) As Variant
  98.  
  99.     LongToBytes = Hex(lVal)
  100.  
  101. End Function
  102.  
  103. Public Function BytesToLong(ByVal sVal As String) As Variant
  104.  
  105.     On Error Resume Next
  106.     Dim l As Double
  107.     Const MaxLong = &H7FFFFFFF
  108.     Const Sign = &H80000000
  109.     Dim signed As Boolean
  110.     
  111.     sVal = Left(sVal, 4)
  112.     l = 0
  113.     If Len(sVal) >= 4 Then
  114.         signed = (CLng(Asc(Mid(sVal, 4, 1))) And &H80)
  115.         If signed Then
  116.             l = l + ((CLng(Asc(Mid(sVal, 4, 1))) And &H7F) * (256 ^ 3))
  117.         Else
  118.             l = l + (CLng(Asc(Mid(sVal, 4, 1))) * (256 ^ 3))
  119.         End If
  120.     End If
  121.     If Len(sVal) >= 3 Then l = l + (CLng(Asc(Mid(sVal, 3, 1))) * (256 ^ 2))
  122.     If Len(sVal) >= 2 Then l = l + (CLng(Asc(Mid(sVal, 2, 1))) * 256)
  123.     l = l + CLng(Asc(Mid(sVal, 1, 1)))
  124.     If signed Then l = Sign + l
  125.     BytesToLong = l
  126.  
  127. End Function
  128.  
  129. Public Function FileExists(ByVal newName As String) As Boolean
  130.  
  131.     On Error Resume Next
  132.     Dim l As Long
  133.     Err.Clear
  134.     l = GetAttr(newName)
  135.     FileExists = (Err = 0 And l <> 16)
  136.     
  137. End Function
  138. Public Sub TrimNulls(newString As String)
  139.     
  140.     If InStr(1, newString, Chr$(0)) > 0 Then newString = Left(newString, InStr(1, newString, Chr$(0)) - 1)
  141.  
  142. End Sub
  143.  
  144.  
  145.